SCI-1402: Projet en science des données

SCI-1402: TN3

1 Introduction

Le projet en science des données représente l’aboutissement du certificat en science des données de l’Université TÉLUQ.Ce projet constitue un complément essentiel de formation pratique et vise à favoriser l’autonomie, l’esprit d’analyse et la rigueur méthodologique dans la conduite d’un projet complet en science des données.

En partenariat avec le Secrétariat à l’Internet haute vitesse et aux projets spéciaux de connectivité du (SIHVPSC) Ministère du Conseil Exécutif ¹, le projet présenté ici s’inscrit dans un contexte concret de développement territorial numérique, avec comme objectif principal l’identification de zones d’intérêt prioritaires pour le déploiement de la fibre optique (Internet haute vitesse)². Ce mandat a permis de mettre en œuvre l’ensemble des compétences développées dans les cours du certificat, notamment :

SCI-1031 : Visualisation et analyse de données spatiales,

SCI-1018 : Statistique avec R,

SCI-1017 : Traitement des données massives,

SCI-1421 : Apprentissage machine.

En croisant des données géospatiales, sociodémographiques et techniques, le projet a exploité des méthodes statistiques, des algorithmes d’apprentissage non supervisé (comme DBSCAN)³ et des outils de traitement de grands volumes de données pour proposer des pistes concrètes d’intervention. L’approche adoptée est fondée sur une démarche rigoureuse : de la collecte des données jusqu’à la communication des résultats, en passant par leur nettoyage, leur exploration et leur modélisation.

Ce projet illustre l’apport stratégique des sciences des données dans la planification d’infrastructures critiques et témoigne du caractère avant-gardiste de la formation offerte dans le cadre du certificat.

2 Méthodologie

L’objectif principal de cette étude est d’identifier des zones d’intérêt prioritaires pour le déploiement de la fibre optique, en analysant la distribution spatiale de points géolocalisés (par exemple, des adresses admissibles à l’Internet haute vitesse). Pour ce faire, nous avons utilisé une approche basée sur la détection de regroupements spatiaux grâce à l’algorithme DBSCAN (Density-Based Spatial Clustering of Applications with Noise), reconnu pour sa capacité à détecter des structures de densité sans supposer un nombre de groupes à l’avance.

Préparation des données Les données sources, composées de coordonnées géographiques en degrés décimaux (latitude/longitude), ont d’abord été nettoyées, géocodées et transformées en objets spatiaux. Cela a permis de faciliter les opérations d’analyse géographique et la visualisation cartographique.

Application de DBSCAN L’algorithme DBSCAN repose sur deux paramètres fondamentaux :

eps, qui représente le rayon maximal autour d’un point pour rechercher des voisins ;

minPts, soit le nombre minimal de points dans ce rayon pour former un regroupement (cluster).

Afin de bien explorer l’espace des paramètres et d’adapter l’algorithme à différents contextes de densité géographique, plusieurs combinaisons de valeurs ont été testées. L’objectif était de faire émerger des regroupements pertinents selon le niveau de concentration des points sur le territoire.

Interprétation des distances Étant donné que les coordonnées sont exprimées en degrés décimaux (ESPG:4326), une conversion approximative en mètres a été effectuée pour mieux interpréter la portée réelle du rayon eps. Aux latitudes du Québec (~46°N), on estime que :

0,01 degré de latitude ≈ 1,11 km (axe nord-sud) ;

0,01 degré de longitude ≈ 0,78 km (axe est-ouest).

Ainsi, un rayon de recherche (eps) de 0,01 correspond à un voisinage spatial d’environ 780 mètres par 1 110 mètres. En augmentant eps à 0,02 ou 0,03, on élargit le périmètre de recherche jusqu’à environ 2,3 km par 3,3 km.

Analyse comparative Chaque combinaison testée de eps et minPts a permis d’observer différentes configurations de regroupements. L’analyse a porté sur plusieurs dimensions :

eps_values <- seq(0.01, 0.06, by = 0.01)

# Approx. des distances en m pour une lat de 46°N
# 1° latitude ≈ 111.32 km
# 1° longitude ≈ 111.32 km × cos(latitude)
lat_m <- 111320  # mètre pour 1° de latitude
lon_m <- 111320 * cos(46 * pi / 180)  # mètre pour 1° de longitude à 46°N

# Création du data frame
df_eps_m <- data.frame(
  Eps_degre = eps_values,
  Distance_NS_m = round(eps_values * lat_m, 0),
  Distance_EW_m = round(eps_values * lon_m, 0)
)

colnames(df_eps_m) <- c("Eps (°)", "Distance nord-sud (m)", "Distance est-ouest (m)")

library(knitr)
kable(df_eps_m, caption = "Correspondance entre eps (en degrés) et les distances approximatives en mètres à 46°N")

Correspondance entre eps (en degrés) et les distances approximatives en mètres à 46°N

Eps (°)	Distance nord-sud (m)	Distance est-ouest (m)
0.01	1113	773
0.02	2226	1547
0.03	3340	2320
0.04	4453	3093
0.05	5566	3866
0.06	6679	4640

le nombre de regroupements détectés ;

la proportion de points classés comme bruit (non regroupés) ;

la répartition géographique des clusters, notamment par région administrative.

Cette approche a permis d’identifier les paramètres les plus efficaces pour faire émerger des zones cohérentes et significatives, à fort potentiel pour des projets d’infrastructure numérique.

2.1 État de la sitiuation

Voici la liste des adresesses réputées non désservries par une desserte internet haute vitesse. Les données proviennent du SIHVPSC.

# Installer les librairies si nécessaires
if (!require("leaflet")) install.packages("leaflet")
if (!require("sf")) install.packages("sf")
if (!require("dplyr")) install.packages("dplyr")
if (!require("RColorBrewer")) install.packages("RColorBrewer")

library(readr)
library(dplyr)
library(leaflet)
library(sf)
library(RColorBrewer)

# Lire les données
setwd("~/Desktop/Teluq/SCI-1402/Data/")
df <- read.csv("resultat_sf.csv", sep = ",", header = TRUE, encoding = "UTF-8")

# Nettoyer les données
df_clean <- df %>%
  filter(!is.na(Longitude), !is.na(Latitude), !is.na(munnom)) %>%
  mutate(
    Longitude = as.numeric(Longitude),
    Latitude = as.numeric(Latitude),
    Region_ADM = as.factor(Region_ADM)
  )

# Générer une palette de couleurs selon munnom
Region_ADM_levels <- levels(df_clean$Region_ADM)
palette_Region_ADM_levels <- colorFactor(palette = brewer.pal(min(length(Region_ADM_levels), 8), "Set1"), domain = Region_ADM_levels)

carte_reg_adm <- leaflet(df_clean) %>%
  addTiles(group = "Base") %>%
  addWMSTiles(
    baseUrl = "https://servicescarto.mern.gouv.qc.ca/pes/services/Territoire/SDA_WMS/MapServer/WMSServer",
    layers = "Région administrative",
    options = WMSTileOptions(format = "image/png", transparent = TRUE),
    attribution = "© MERN - Gouvernement du Québec",
    group = "Contours SDA"
  ) %>%
  addCircleMarkers(
    lng = ~Longitude,
    lat = ~Latitude,
    radius = 4,
    color = ~palette_Region_ADM_levels(Region_ADM),
    fillOpacity = 0.8,
    stroke = FALSE,
    label = ~paste0("Municipalité: ", munnom, "<br>Latitude: ", Latitude, "<br>Longitude: ", Longitude)
  ) %>%
  addLegend(
    position = "bottomright",
    pal = palette_Region_ADM_levels,
    values = ~Region_ADM,
    title = "Region_ADM",
    opacity = 1
  )

2.2 Statistiques par région

stats_region <- df_clean %>%
  filter(!is.na(Region_ADM)) %>%
  group_by(Region_ADM) %>%
  summarise(
    Nombre_points = n()
  ) %>%
  arrange(desc(Nombre_points))

library(kableExtra)

stats_region %>%
  kable("html", caption = "Nombre de points par région administrative") %>%
  kable_styling(full_width = FALSE, bootstrap_options = c("striped", "hover", "condensed"))

Nombre de points par région administrative

Region_ADM	Nombre_points
Outaouais	6789
Montérégie	4333
Chaudière-Appalaches	3768
Laurentides	3445
Estrie	3200
Lanaudière	3129
Saguenay–Lac-Saint-Jean	3072
Montréal	2923
Centre-du-Québec	2322
Capitale-Nationale	2224
Bas-Saint-Laurent	2156
Abitibi-Témiscamingue	1921
Mauricie	1207
Laval	882
Côte-Nord	678
Nord-du-Québec	651
Gaspésie–Îles-de-la-Madeleine	359

2.3 Autre carte par région

# Lire les centroïdes des régions
df_centroïdes <- read_csv("centroides_regions_quebec.csv")

# Lire le fichier des pourcentages non couverts
df_points <- read_csv("comparatif_points.csv")

# Nettoyer la colonne "pourcentage_non_couvert"
df_points <- df_points %>%
  mutate(
    pourcentage_non_couvert = as.numeric(gsub("%", "", Pourcentage_non_couvert))
  )

# Fusionner sur le code de région
df_merged <- df_centroïdes %>%
  left_join(df_points, by = c("Nom" = "Region_ADM"))

# Créer un objet sf à partir des centroïdes
sf_regions <- st_as_sf(df_merged, coords = c("Longitude", "Latitude"), crs = 4326)

# Créer une palette de couleurs rouge → vert (valeur élevée = rouge)
pal <- colorNumeric(
  palette = "RdYlGn",
  domain = sf_regions$pourcentage_non_couvert,
  reverse = TRUE
)

# Créer la carte Leaflet
leaflet(sf_regions) %>%
  addProviderTiles("CartoDB.Positron") %>%
  addCircleMarkers(
    radius = ~sqrt(pourcentage_non_couvert) * 10,
    color = ~pal(pourcentage_non_couvert),
    stroke = FALSE,
    fillOpacity = 0.7,
    popup = ~paste0(
      "<strong>", Nom, "</strong><br>",
      "Pourcentage non couvert : ", round(pourcentage_non_couvert, 1), "%"
    )
  ) %>%
  addLegend(
    "bottomright",
    pal = pal,
    values = ~pourcentage_non_couvert,
    title = "Pourcentage des adresses non couvertes (%)",
    opacity = 0.8
  )

# Installer les librairies si nécessaires
if (!require("geojsonio")) install.packages("geojsonio")
if (!require("leaflet")) install.packages("leaflet")
if (!require("dbscan")) install.packages("dbscan")
if (!require("sf")) install.packages("sf")
if (!require("dplyr")) install.packages("dplyr")
if (!require("ggplot2")) install.packages("ggplot2")
if (!require("ggforce")) install.packages("ggforce")
if (!require("kableExtra")) install.packages("kableExtra")

library(readr)
library(dplyr)
library(dbscan)
library(leaflet)
library(sf)
library(geojsonio)
library(RColorBrewer)


coords <- df_clean %>%
  select(Longitude, Latitude) %>%
  as.matrix()

# Paramètres DBSCAN
eps_values <- seq(0.01, 0.03, by = 0.01)
minPts_values <- seq(70, 30, by = -10)

# Créer la carte Leaflet
carte <- leaflet() %>%
  addTiles(group = "Base") %>%
  addWMSTiles(
    baseUrl = "https://servicescarto.mern.gouv.qc.ca/pes/services/Territoire/SDA_WMS/MapServer/WMSServer",
    layers = "Région administrative",
    options = WMSTileOptions(format = "image/png", transparent = TRUE),
    attribution = "© MERN - Gouvernement du Québec",
    group = "Contours SDA"
  )

# Liste pour garder le nom des groupes
group_names <- c()

# Générer les itérations de clustering
for (eps in eps_values) {
  for (minPts in minPts_values) {
    label <- sprintf("eps=%.2f_minPts=%d", eps, minPts) 
    group_names <- c(group_names, label)
    
    # Appliquer DBSCAN
    db <- dbscan(coords, eps = eps, minPts = minPts)
    df_iter <- df_clean %>%
      mutate(cluster = as.factor(db$cluster))
    
       df_iter_grouped <- df_iter %>%
      filter(cluster != 0)
    
    # Ajouter le nombre de points par cluster
    cluster_counts <- df_iter_grouped %>%
      count(cluster, name = "n_points")
    
    df_iter_grouped <- df_iter_grouped %>%
      left_join(cluster_counts, by = "cluster")
    
    # Ajouter à la carte dans un groupe spécifique
    carte <- carte %>%
      addCircleMarkers(
        data = df_iter_grouped,
        lng = ~Longitude,
        lat = ~Latitude,
        #color = ~ifelse(cluster == 0, "gray", RColorBrewer::brewer.pal(8, "Set1")[as.integer(cluster)]),
        color = ~palette_Region_ADM_levels(Region_ADM),
        radius = ~ifelse(cluster == 0, 1, 4),
        fillOpacity = 0.8,
        stroke = FALSE,
        group = label,
        label = ~paste("Cluster:", cluster, ": Nb points:", n_points)
      )
  }
}

2.4 Carte interactive des regroupements

# Ajouter le contrôle des couches avec baseGroups
carte <- carte %>%
  addLayersControl(
    baseGroups = group_names,
    overlayGroups = c("Contours SDA"),
    options = layersControlOptions(collapsed = FALSE)
  ) %>%
  hideGroup(setdiff(group_names, group_names[1]))  # Cacher tous sauf le 1er

carte

2.5 Statistiques par itération DBSCAN pour la province

Afin de déterminer les paramètres optimaux pour l’algorithme DBSCAN, plusieurs itérations ont été effectuées en faisant varier les valeurs de eps (rayon de voisinage) et de minPts (nombre minimal de points requis pour former un regroupement). Chaque combinaison de paramètres a permis de générer une partition différente des données géographiques de la province, produisant des regroupements (clusters) de points potentiellement intéressants pour le déploiement de la fibre optique.

Pour chaque itération, les statistiques suivantes ont été calculées :

Le nombre total de points regroupés (c’est-à-dire les points inclus dans un cluster) ;

Le nombre de clusters identifiés, excluant le bruit ;

Le pourcentage de points regroupés, un indicateur de la couverture ou de la densité apparente ;

Le nombre de points considérés comme du bruit, soit les points isolés ne satisfaisant pas les critères de densité.

Ces statistiques permettent de comparer objectivement les effets des différents paramètres et d’identifier les combinaisons les plus efficaces pour faire émerger des zones d’intérêt bien définies. Les résultats ont été compilés dans un tableau comparatif “Statistiques par itération DBSCAN pour la province”, facilitant l’analyse et la sélection des itérations les plus pertinentes pour une application concrète sur le terrain.

# Statistiques par itération DBSCAN pour le province au
res_dbscan <- list()

# Refaire les itérations pour calculer les stats
for (eps in eps_values) {
  for (minPts in minPts_values) {
    label <- sprintf("eps=%.2f_minPts=%d", eps, minPts)

    # Appliquer DBSCAN
    db <- dbscan(coords, eps = eps, minPts = minPts)
    clusters <- db$cluster
    
    n_total <- length(clusters)
    n_bruit <- sum(clusters == 0)
    n_regroupes <- n_total - n_bruit
    n_clusters <- length(unique(clusters)) - ifelse(any(clusters == 0), 1, 0) 
    
    pourcentage_regroupes <- (n_regroupes / n_total) * 100
    
    res_dbscan[[label]] <- data.frame(
      Paramètres = label,
      Nombre_de_clusters = n_clusters,
      Nombre_de_points_regroupes = n_regroupes,
      Pourcentage_de_points_regroupes = round(pourcentage_regroupes, 1)
    )
  }
}

# Combiner tous les résultats en un seul tableau
df_stats_dbscan <- do.call(rbind, res_dbscan)

library(knitr)
library(kableExtra)

# Afficher le tableau avec bordure
kable(df_stats_dbscan, caption = "Résumé statistique pour chaque itération de DBSCAN", format = "html") %>%
  kable_styling(bootstrap_options = c("striped", "bordered"), full_width = FALSE)

Résumé statistique pour chaque itération de DBSCAN

	Paramètres	Nombre_de_clusters	Nombre_de_points_regroupes	Pourcentage_de_points_regroupes
eps=0.01_minPts=70	eps=0.01_minPts=70	36	4758	11.0
eps=0.01_minPts=60	eps=0.01_minPts=60	43	5575	12.9
eps=0.01_minPts=50	eps=0.01_minPts=50	53	6406	14.9
eps=0.01_minPts=40	eps=0.01_minPts=40	76	7901	18.3
eps=0.01_minPts=30	eps=0.01_minPts=30	115	9815	22.8
eps=0.02_minPts=70	eps=0.02_minPts=70	54	9750	22.6
eps=0.02_minPts=60	eps=0.02_minPts=60	61	11108	25.8
eps=0.02_minPts=50	eps=0.02_minPts=50	76	12715	29.5
eps=0.02_minPts=40	eps=0.02_minPts=40	107	15204	35.3
eps=0.02_minPts=30	eps=0.02_minPts=30	155	18800	43.7
eps=0.03_minPts=70	eps=0.03_minPts=70	59	15572	36.2
eps=0.03_minPts=60	eps=0.03_minPts=60	72	17085	39.7
eps=0.03_minPts=50	eps=0.03_minPts=50	85	19249	44.7
eps=0.03_minPts=40	eps=0.03_minPts=40	107	21400	49.7
eps=0.03_minPts=30	eps=0.03_minPts=30	150	25064	58.2

2.6 Statistiques par itération DBSCAN par région administrative

Afin d’affiner l’analyse territoriale, les résultats du clustering ont été ventilés par région administrative. Cette décomposition permet de mieux comprendre la répartition des regroupements à l’échelle locale et de comparer l’efficacité des paramètres de DBSCAN selon les contextes géographiques. Pour chaque région et chaque itération, des statistiques similaires à celles calculées à l’échelle provinciale ont été compilées, facilitant ainsi l’identification des zones prioritaires à l’intérieur de chaque territoire.

# Extraire les minPts et eps depuis les labels
df_stats_dbscan <- df_stats_dbscan %>%
  mutate(
    eps = as.numeric(sub(".*eps=([0-9.]+)_minPts=.*", "\\1", rownames(df_stats_dbscan))),
    minPts = as.numeric(sub(".*minPts=([0-9]+)", "\\1", rownames(df_stats_dbscan)))
  )

library(ggplot2)

# Nuage de points : taille selon Nombre de clusters, couleur selon % de points regroupés
ggplot(df_stats_dbscan, aes(x = minPts, y = eps)) +
  geom_point(aes(size = Nombre_de_clusters, color = Pourcentage_de_points_regroupes), alpha = 0.8) +
  geom_text(aes(label = paste0(Pourcentage_de_points_regroupes, "%")), vjust = -0.5, size = 3) +
  scale_color_gradient(low = "red", high = "green") +
  scale_size_continuous(range = c(3, 10)) +  # contrôle la plage de taille
  scale_y_continuous(expand = expansion(mult = c(0.05, 0.15))) +
  scale_x_reverse() +
  labs(
    title = "Nuage de points: minPts vs eps",
    subtitle = "Taille = Nombre de clusters, Couleur = % de points regroupés",
    x = "Nombre minimum de points (minPts)",
    y = "Distance maximum (eps)",
    color = "% de points regroupés",
    size = "Nombre de clusters"
  ) +
  theme_minimal()

# DBSCAN par région
regions <- unique(df_clean$Region_ADM)

res_dbscan_region <- list()

for (region in regions) {
  
  df_region <- df_clean %>% filter(Region_ADM == region)
  
  coords_region <- df_region %>% 
    select(Longitude, Latitude) %>% 
    as.matrix()
  
  for (eps in eps_values) {
    for (minPts in minPts_values) {
      label <- sprintf("eps=%.2f_minPts=%d", eps, minPts)
      
      # Appliquer DBSCAN sur la région
      db <- dbscan(coords_region, eps = eps, minPts = minPts)
      clusters <- db$cluster
      
      n_total <- length(clusters)
      n_bruit <- sum(clusters == 0)
      n_regroupes <- n_total - n_bruit
      n_clusters <- length(unique(clusters)) - ifelse(any(clusters == 0), 1, 0)
      
      pourcentage_regroupes <- (n_regroupes / n_total) * 100
      
      res_dbscan_region[[paste(region, label)]] <- data.frame(
        Region_ADM = region,
        eps = eps,
        minPts = minPts,
        Nombre_de_clusters = n_clusters,
        Nombre_de_points_regroupes = n_regroupes,
        Pourcentage_de_points_regroupes = round(pourcentage_regroupes, 2)
      )
    }
  }
}



library(ggforce)

# Combiner tous les résultats
df_stats_dbscan_region <- do.call(rbind, res_dbscan_region)

# Déterminer le nombre total de régions
n_regions <- length(unique(df_stats_dbscan_region$Region_ADM))

# Déterminer le nombre de pages (2 régions par page)
n_pages <- ceiling(n_regions / 2)

for (i in 1:n_pages) {
  p <- ggplot(df_stats_dbscan_region, aes(x = minPts, y = eps)) +
    geom_point(aes(size = Nombre_de_clusters, color = Pourcentage_de_points_regroupes), alpha = 0.8) +
    geom_text(aes(label = paste0(Pourcentage_de_points_regroupes, "%")), vjust = -0.5, size = 2.5) +
    scale_color_gradient(low = "red", high = "green") +
    scale_size_continuous(range = c(2, 8)) +
    scale_y_continuous(expand = expansion(mult = c(0.05, 0.15))) +
    scale_x_reverse() +
    ggforce::facet_wrap_paginate(
      ~Region_ADM,
      ncol = 1,
      nrow = 2,   
      page = i
    ) +
    labs(
      title = "Clustering DBSCAN par Région administrative",
      subtitle = paste("Page", i, "sur", n_pages),
      x = "Nombre minimum de points (minPts)",
      y = "Distance maximum (eps)",
      color = "% de points regroupés",
      size = "Nombre de clusters"
    ) +
    theme_minimal()
  
  print(p)
}

2.7

3 Conclusion

4 Remerciements

Je tiens à remercier sincèrement tous les professeurs et tuteurs de l’Université TÉLUQ pour la qualité exceptionnelle de l’enseignement reçu tout au long du certificat en science des données. Votre approche rigoureuse, accessible et résolument avant-gardiste a grandement contribué à mon apprentissage et à mon développement professionnel. Merci pour votre engagement et votre passion.

Je tiens aussi à exprimer ma profonde gratitude envers l’équipe du Secrétariat Inter haute Vitesse et projets spéciaux en connectivité du Ministère du Conseil exécutif. Votre vision innovante, votre confiance et votre volonté constante de repousser les limites en matière de connectivité ont été une source d’inspiration tout au long de mon parcours. Merci pour votre engagement avant-gardiste au service du développement du numérique au Québec.

5 Références

---

1. https://www.quebec.ca/gouvernement/ministeres-organismes/sihv↩︎

2. Consulter la carte https://www.quebec.ca/habitation-territoire/amenagement-developpement-territoires/carte-internet-haute-vitesse↩︎

3. Voir https://fr.wikipedia.org/wiki/DBSCAN pour plus d’information.↩︎